home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / m2menu.zip / MENU1.MOD < prev    next >
Text File  |  1990-03-22  |  4KB  |  162 lines
  1.  
  2.  MODULE menu1; (* TopSpeed Modula-2 V 1.16 *)
  3.  
  4.  FROM IO     IMPORT  WrChar, WrLn, WrStr, WrStrAdj;
  5.  FROM Str    IMPORT  Length;
  6.  FROM Window IMPORT  Black, White, Clear, Close, DoubleFrame,
  7.                      GotoXY, Open, WinDef, WinType;
  8.  IMPORT MenuIO, IO;
  9.  
  10.  CONST
  11.    DescLen  = 40;  (* label length *)
  12.    Offset   = 1;
  13.    NumMain  = 10;  (* total number of selections *)
  14.  
  15.    bel = 7C;
  16.    esc = 33C;
  17.  
  18.    F1 = 273C;
  19.    F2 = 274C;
  20.    F3 = 275C;
  21.    F4 = 276C;
  22.    F5 = 277C;
  23.    F6 = 300C;
  24.    F7 = 301C;
  25.    F8 = 302C;
  26.    F9 = 303C;
  27.    F10 = 304C;
  28.  
  29.  TYPE
  30.    xType = RECORD
  31.              ch: CHAR;
  32.              desc: ARRAY [0..DescLen] OF CHAR;
  33.            END;
  34.  VAR
  35.    MainMenu : ARRAY [0..NumMain-1] OF xType;
  36.     sc, Xch : CHAR;
  37.     MenuWin : WinType;
  38.  
  39.  (* make a self-centering, self-wrapping menu *)
  40.  
  41.  PROCEDURE MakeMenu(xArr: ARRAY OF xType): CHAR;
  42.  CONST
  43.    ScrDepth = 25;
  44.    ScrWidth = 80;
  45.  
  46.  VAR
  47.    width, depth, left, top, right, bottom : CARDINAL;
  48.    i, j, len, maxLength: CARDINAL;
  49.    getCH, result : CHAR;
  50.    WD, smWD : WinDef;
  51.    xWidth: INTEGER;
  52.  
  53.    BEGIN
  54.    maxLength := Length(xArr[0].desc);
  55.      FOR j := 1 TO HIGH(xArr) DO
  56.        len := Length(xArr[j].desc);
  57.        IF len > maxLength THEN
  58.          maxLength := len
  59.        END(*IF*)
  60.      END;(*FOR*)
  61.    width := maxLength+3;
  62.    depth := HIGH(xArr)+2;
  63.    left := (ScrWidth-width) DIV 2;
  64.    right := left+width;
  65.    top := (ScrDepth-depth) DIV 3;
  66.    bottom := top+depth;
  67.    xWidth := -INTEGER(width);
  68.    WITH WD DO
  69.      X1 := left;
  70.      Y1 := top;
  71.      X2 := right;
  72.      Y2 := bottom;
  73.      Foreground := White;
  74.      Background := Black;
  75.      CursorOn := FALSE;
  76.      WrapOn := FALSE;
  77.      Hidden := FALSE;
  78.      FrameOn := TRUE;
  79.      FrameDef:= DoubleFrame;
  80.      FrameFore:= White;
  81.      FrameBack:= Black
  82.    END;(*WITH*)
  83.      MenuWin := Open(WD);
  84.      FOR i := 0 TO HIGH(xArr) DO
  85.        WITH xArr[i] DO
  86.          WrLn;
  87.          WrChar(' ');
  88.          WrStr(desc)
  89.        END(*WITH*)
  90.      END;(*FOR*)
  91.  
  92.    LOOP
  93.      getCH := MenuIO.GetKey(sc);
  94.      CASE getCH OF
  95.        F1..F10 : result := xArr[ORD(sc)-59].ch; EXIT
  96.        | esc: result := esc; EXIT
  97.      ELSE
  98.        WrChar(bel);
  99.      END;(*CASE*)
  100.    END;(*LOOP*)
  101.    Close(MenuWin);
  102.    RETURN result;
  103.  END MakeMenu;
  104.  
  105.  (* menu labels *)
  106.  
  107.  PROCEDURE MenuLabel(VAR xArr: ARRAY OF xType);
  108.  BEGIN
  109.    xArr[0].ch := '1';
  110.    xArr[1].ch := '2';
  111.    xArr[2].ch := '3';
  112.    xArr[3].ch := '4';
  113.    xArr[4].ch := '5';
  114.    xArr[5].ch := '6';
  115.    xArr[6].ch := '7';
  116.    xArr[7].ch := '8';
  117.    xArr[8].ch := '9';
  118.    xArr[9].ch := '0';
  119.    xArr[0].desc := "F1...Item One";
  120.    xArr[1].desc := "F2...Item Two";
  121.    xArr[2].desc := "F3...Item Three";
  122.    xArr[3].desc := "F4...Item Four";
  123.    xArr[4].desc := "F5...Item Five";
  124.    xArr[5].desc := "F6...Item Six";
  125.    xArr[6].desc := "F7...Item Seven";
  126.    xArr[7].desc := "F8...Item Eight";
  127.    xArr[8].desc := "F9...Item Nine";
  128.    xArr[9].desc := "F10..Item Ten"
  129.  END MenuLabel;
  130.  
  131.  (* execute selection *)
  132.  
  133.  PROCEDURE MenuAction(VAR xArr: ARRAY OF xType);
  134.  BEGIN
  135.    CASE Xch OF
  136.      '0'..'9' : Clear;
  137.                 WrStr("Selection ");
  138.                 WrStr(xArr[ORD(sc)-59].desc);
  139.                 WrStr(": Executed!");
  140.                 WrLn;
  141.                 WrLn;
  142.                 MenuIO.ExecCmd('pause')
  143.    END;(*CASE*)
  144.  END MenuAction;
  145.  
  146.  (* run program *)
  147.  
  148.  BEGIN
  149.    MenuLabel(MainMenu); (* initialize *)
  150.  
  151.    LOOP
  152.      Clear;
  153.      GotoXY(30,3);
  154.        WrStr("<Esc> key exits program");
  155.      GotoXY(20,18);
  156.        WrStr("Hit a function key to make your selection > ");
  157.      Xch := MakeMenu(MainMenu);
  158.      IF Xch = esc THEN EXIT END;
  159.      MenuAction(MainMenu) (* execute *)
  160.    END;(*LOOP*)
  161.    Clear
  162.  END menu1.